//SCAR Plugin. Created for SCAR Divi by Kaitnieks & Freddy1990
// currently you can't call SCAR functions from plugin
library XFindRock;

uses
  FastShareMem,
  SysUtils,
  Classes,
  Windows,
  Dialogs,
  Math,
  PngImage,
  Graphics,
  Forms,
  DllForm in 'DllForm.pas' {frmDllForm};


{$R *.res}


type
  TPoint = Record
    x,y : integer;
  end;
  TPointArray = Array of TPoint;
  TMaskRay = Record
    xOff, yOff : Integer;
    Width,Height:Integer;
    CheckPoint : TPoint;
    WhiteArray : TPointArray;
    BlackArray : TPointArray;
  end;
  TPointArrayArray = Array of Array of TPoint;
type
  THandles = Packed record
    Bitmap : HBitmap;
    Client : HDC;
  end;
  TRGB32 = packed record
    B, G, R, A: Byte;
  end;
  TRGB32Array = packed array[0..MaxInt div SizeOf(TRGB32) - 1] of TRGB32;
  PRGB32Array = ^TRGB32Array;
type
  TIntegerArray = array of Integer;

type
  TBox = Record
    x1,y1,x2,y2:Integer;
  end;
  TBoxArray = Array of TBox;
type
  TSCARPlugFunc = record
    Name: string;
    Ptr: Pointer;
  end;

  TNumbers = record
    n1, n2: Integer;
  end;
Const
  Radix = 10;  //I can't really explain.. Radix 10 is used the most.. It stands for 0,1,2,3,4,5,6,7,8,9.. And if your using negative numbers to, its -9..9
Type
  TOneStrProc = procedure(s: string);

var
   Bmp : TBitmap;
   LineLength : LongInt;
   ScanLinePointer : PRGB32Array;

var
  Writeln: TOneStrProc;


var
  OldApphandle:longint = 0;


Procedure ShowTestForm(AppHandle:integer); stdcall;
begin
  if Application.Handle <> AppHandle then
    OldAppHandle := Application.Handle;
  Application.Handle := AppHandle;
  frmDllForm := TfrmDllForm.Create(Application);
  frmDllForm.Show;
end;

function ShowTestFormModal(AppHandle:integer):longint; stdcall;
begin
  OldAppHandle := Application.Handle;
  try
    Application.Handle := AppHandle;
    frmDllForm := TfrmDllForm.Create(Application);
    try
      frmDllForm.ShowModal
    except
    end;
  finally
    Application.Handle := OldAppHandle;
  end;
end;

procedure ShowDllForm;stdcall;
begin
  frmDllForm :=TfrmDllForm.Create(nil);
  frmDllForm.Show;
end;

Procedure ShowDllFormModal;stdcall;
begin
  frmDllForm :=TfrmDllForm.Create(nil);
  frmDllForm.ShowModal;
end;

Function IntToBox(x1,y1,x2,y2 : integer) : TBox;
begin;
  Result.x1 := x1;
  Result.y1 := y1;
  Result.x2 := x2;
  Result.y2 := y2;
  ArcTan2(50,50);
end;
Procedure PNGToBitmap(LoadPath,SavePath : String);stdcall;
var
  PnGImg : TPNGObject;
  Bmp : TBitmap;
begin
  PnGImg := TPNGObject.Create;
  PnGImg.LoadFromFile(LoadPath);
  Bmp := TBitmap.Create;
  Bmp.Assign(PnGImg);
  Bmp.SaveToFile(SavePath);
  Bmp.Free;
  PnGImg.Free;
end;
//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArray(var Counts: TIntegerArray;var Points : TPointArray);
var
  Len, i, j, k,h: LongInt;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;

//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
Procedure SortTPointArrayE(var Counts: Array of Extended;var Points : TPointArray);
var
  Len, i, j, k: LongInt;
  H : Extended;
  Temp : TPoint;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] > Counts[j + k]) do
      begin
        h := Counts[j];
        Temp := Points[j];
        Counts[j] := Counts[j + k];
        Points[j] := Points[J + K];
        Points[J+K] := Temp;
        Counts[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;



//Credits to original maker!
//http://www.swissdelphicenter.ch/torry/showcode.php?id=1616
procedure SortColorsCount(var Colors,  Counts: TIntegerArray);
var
  Len, i, j, k,h,tmp: LongInt;
begin
  Len := High(Counts);
  k := Len shr 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Counts[j] < Counts[j + k]) do
      begin
        h := Counts[j];
        tmp := Colors[j];
        Counts[j] := Counts[j + k];
        Counts[j + k] := h;
        Colors[j] := Colors[J + k];
        Colors[J + K] :=tmp;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
end;

Function GetTPABounds(TPA: TPointArray): TBox; stdcall;
var
  I,L : Integer;
begin;
  L := High(TPA);
  if L < 0 then exit;
  Result.x1 := TPA[0].x;
  Result.y1 := TPA[0].y;
  Result.x2 := TPA[0].x;
  Result.y2 := TPA[0].y;
  For I:= 1 to L do
  begin;
    if TPA[i].x > Result.x2 then
      Result.x2 := TPA[i].x
    else if TPA[i].x < Result.x1 then
      Result.x1 := TPA[i].x;
    if TPA[i].y > Result.y2 then
      Result.y2 := TPA[i].y
    else if TPA[i].y < Result.y1 then
      Result.y1 := TPA[i].y;
  end;
end;

Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;stdcall;
var
  Len, I,II,LenSearch,xOff,yOff : integer;
  tx,ty,MatchCount : integer;
  Screen : Array of Array of Boolean;
  ScreenBox,SearchBox : TBox;
  Bool : Boolean;
begin;
  Result := False;
  Len := High(TotalTPA);
  LenSearch := High(SearchTPA);
  if LenSearch < 0 then Exit;
  if Len < LenSearch then Exit;
  MatchCount := 0;
  ScreenBox := GetTPABounds(TotalTPA);
  SearchBox := GetTPABounds(SearchTPA);
  Try
    SetLength(Screen,ScreenBox.x2 + 1,ScreenBox.y2 + 1);
  Except
    Exit;
  end;
  if (SearchBox.x1 > 0) or (SearchBox.y1 > 0) then
  begin;
    For I := 0 to LenSearch do
    begin;
      SearchTPA[I].x := SearchTPA[I].x - SearchBox.x1;
      SearchTPA[I].y := SearchTPA[I].y - SearchBox.y1;
    end;
    SearchBox.x2 := SearchBox.x2 - SearchBox.x1;
    SearchBox.y2 := SearchBox.y2 - SearchBox.y1;
    SearchBox.x1 := 0;
    SearchBox.y1 := 0;
  end;
  xOff := SearchBox.x2;
  yOff := SearchBox.y2;
  For I := 0 to LenSearch do
  begin;
    if SearchTPA[I].x = 0 then
      if SearchTPA[I].y < yOff then
        yOff := SearchTPA[I].y;
    if SearchTPA[I].y = 0 then
      if SearchTPA[I].x < xOff then
        xOff := SearchTPA[I].x;
  end;
  For I := 0 to Len do
    Screen[TotalTPA[I].x][TotalTPA[I].y] := True;
  For I := 0 to Len do
  begin;
    tx := TotalTPA[I].x - xOff;
    ty := TotalTPA[I].y;// - yOff;
    if tx > 0 then
      if ty > 0 then
        if (SearchBox.x2 + tx) <= ScreenBox.x2 then
          if (SearchBox.y2 + ty) <= ScreenBox.y2 then
          begin;
            Bool := True;
            For II := 0 to LenSearch do
              if Screen[tx + SearchTPA[II].x ][ty + SearchTPA[II].y] = False then
              begin;
                Bool := False;
                Break;
              end;
            if bool then
            begin;
              MatchCount := MatchCount + 1;
              SetLength(Matches,MatchCount);
              Matches[MatchCount - 1].x := TotalTPA[I].x;
              Matches[MatchCount - 1].y := TotalTPA[I].y;
            end;
          end;
  end;
  if MatchCount > 0 then
    Result := True;
end;

Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :TpointArrayArray;stdcall;
var
  Len,TotalLen,LenRes,I,II,III : integer;
  Screen : Array of Array of Boolean;
  Height,Width : Integer;
  Box : TBox;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Box := GetTPABounds(TPA);
  Height := Box.y2 - Box.y1;
  Width := Box.x2 - Box.x1;
  LenRes := 0;
  III := 0;
  Try
    SetLength(Screen,Width + 1,Height + 1);
  Except
    Exit;
  end;
  For I := 0 to Len do
    Screen[TPA[I].x - Box.x1][TPA[I].y - Box.y1] := True;
  SetLength(result,1);
  SetLength(Result[0],Len+1);
  TotalLen := 0;
  For I := 0 to Width do
  begin;
    For II := 0 to Height do
      if Screen[I][II]=True then
      begin;
        Result[TotalLen][LenRes].x := I + Box.x1;
        Result[TotalLen][LenRes].y := II + Box.y1;
        LenRes := LenRes + 1;
        III := I;
      end;
    if LenRes = 0 then
      III := I
    else
    if (I - III) > MinPixels then
    begin;
      III := I;
      SetLength(Result[TotalLen],LenRes);
      LenRes := 0;
      TotalLen := TotalLen + 1;
      SetLength(Result,TotalLen + 1);
      SetLength(Result[TotalLen],Len + 1);
    end;
  end;
  SetLength(Result[TotalLen],LenRes);
end;

Procedure EditToBounds( var TPA : TPointArray);stdcall;
var
  I : Integer;
  L : Integer;
  Box : TBox;
begin;
  Box := GetTPABounds(TPA);
  if (Box.x1 = 0) and (Box.y1 = 0) then
    exit;
  L := High(TPA);
  For I := 0 to L do
  begin;
    Tpa[I].x := TPA[I].x - Box.x1;
    TPA[I].y := TPA[I].y - Box.y1;
  end;
end;

Function GayBounds(Points: TPointArray): TBox; stdcall;

Var
   L, I: Integer;

Begin
  Result.X1 := 0 xor 0;
  Result.Y1 := 0 xor 0;
  Result.X2 := 1 shl 20;
  Result.Y2 := 1 shl 20;
  L := High(Points);
  For I := 0 To L Do
  Begin
    Result.X1 := Min(Result.X1, Points[I].X);
    Result.Y1 := Min(Result.Y1, Points[I].Y);
    Result.X2 := Max(Result.X2, Points[I].X);
    Result.Y2 := Max(Result.Y2, Points[I].Y);
  End;
End;

Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;stdcall;
var
  I, II, C,HighTPA: Integer;
  Keep: Boolean;
begin
  C:= 0;
  HighTPA := High(TPA);
  SetLength(Result, HighTPA + 1);
  for I:= 0 to HighTPA do
  begin
    Keep:= True;
    for II:= (I + 1) to HighTPA do
      if sqrt ( (TPA[II].x - TPA[I].x) * (TPA[II].x - TPA[I].x) + (TPA[II].y - TPA[I].y) * (TPA[II].y - TPA[I].y)) <= Dist then
      begin
        Keep:= False;
        break;
      end;
    if keep then
    begin
      Result[C].x:= TPA[I].x;
      Result[C].y := TPA[I].y;
      C := C + 1;
    end;
  end;
  SetLength(Result, C);
end;
Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : TPointArrayArray);Stdcall;
var
  L,LL,Count : integer;
  I : integer;
begin;
  L := High(ATPA);
  Count := -1;
  For I:= 0 to L do
  begin;
    LL := Length(ATPA[I]);
    if LL > MinLength then
      if LL < MaxLength then
      begin;
        Count := Count + 1;
        if I <> Count then
          ATPA[Count] := ATPA[I];
      end;
  end;
  SetLength(ATPA,Count+1);
end;

function RemoveTPASameRange(dist : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II : Integer;
  Bool : boolean;
begin;
  L := -1;
  HighTPA := High(TPA);
  SetLength(Result,HighTPA + 1);
  For I:= 0 to HighTPA do
  begin;
    Bool := False;
    For II := 0 to L do
      if sqrt ( (Result[II].x - TPA[I].x) * (Result[II].x - TPA[I].x) + (Result[II].y - TPA[I].y) * (Result[II].y - TPA[I].y)) <= Dist then
      begin;
        Bool := True;
        Break;
      end;
    if not Bool then
    begin;
      L := L + 1;
      Result[L].x := TPA[I].x;
      Result[L].y := Tpa[I].y;
    end;
  end;
  SetLength(Result,L+1);
end;
Function ColorToRGBASM( Color : integer;var R,G,B : integer): integer; stdcall;
asm
  pop edx
  mov eax,[edx]
{  mov [edx],eax
  and [edx],$FF
  shr eax,8
  mov [ecx],eax
  and [ecx],$FF
  shr eax,8
  mov [edx-8],eax
  and [edx-8],$FF}
//  mov [edx-16],$FF
//  mov eax, color
end;
Function AbsoluteInt ( SomeNumber : integer) : integer;assembler;stdcall;
asm
//  mov eax,edx
  mov eax,edx
  mov ecx, edx
  sar ecx, 31
  add eax, ecx
  xor eax, ecx
end;

Function FindCommonPoint(ArrayTPA : TPointArrayArray) : TPointArray;stdcall;
var
  L, HighTPA,I,II,III : Integer;
  Lengths : TIntegerArray;
  Bool : boolean;
begin;
  Bool := False;
  L := -1;
  HighTPA := High(ArrayTPA);
  if HighTPA < 1 then exit;
  SetLength(Lengths,HighTPA +  1);
  For I:= 0 to HighTPA do
    Lengths[I] := High(ArrayTPA[I]);
  For I:= 0 to Lengths[0] do
  begin;
    For II := 1 to HighTPA do
    begin;
      Bool := False;
      For III := 0 to Lengths[II] do
        if ArrayTPA[0][I].x = ArrayTPA[II][III].x then
          if ArrayTPA[0][I].y = ArrayTPA[II][III].y then
          begin;
            Bool := True;
            Break;
          end;
      if not Bool then Break;
    end;
    if Bool then
    begin;
      L := L + 1;
      SetLength(Result,L+1);
      Result[L] := ArrayTPA[0][I];
    end;
  end;
end;

Function FloodFillTPA(TPA : TPointArray) : TPointArrayArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy : integer;
begin;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+3,TempBox.y2 - TempBox.y1+3);
  x := TempBox.x1 - 1;
  y := TempBox.y1 - 1;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        if PointsToFill[fx+1][fy] then
        begin
          fx := fx + 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy+1] then
        begin
          fx := fx;fy := fy + 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy] then
        begin
          fx := fx - 1;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx][fy-1] then
        begin
          fx := fx;fy := fy - 1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy+1] then
        begin
          fx := fx+1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy-1] then
        begin
          fx := fx-1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx-1][fy + 1] then
        begin
          fx := fx-1;fy := fy+1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        if PointsToFill[fx+1][fy-1] then
        begin
          fx := fx+1;fy := fy-1;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Continue;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;

Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : TPointArrayArray;stdcall;
var
  x,y,i,CurrentArray, LengthTPA,CurrentStack,DistMin : integer;
  TempBox : TBox;
  PointsToFill : Array of Array of Boolean;
  Lengths : TIntegerArray;
  TempTPA : TPointArray;
  Stack : TPointArray;
  fx,fy,ii,iii : integer;
label
  Start;
begin;
  if Dist < 1 then
    Dist := 1;
  DistMin := Dist - 1;
  LengthTPA := High(TPA);
  if LengthTPA < 1 then
  begin;
    if LengthTPA = 0 then
    begin;
      SetLength(Result,1,1);
      Result[0][0] := TPA[0];
    end else
      SetLength(Result,0);
    exit;
  end;
  TempBox := GetTPABounds(TPA);
  SetLength(PointsToFill,TempBox.x2 - TempBox.x1+(Dist*2) + 1,TempBox.y2 - TempBox.y1+(Dist *2) + 1);
  x := TempBox.x1 - Dist;
  y := TempBox.y1 - Dist;
  CurrentArray := -1;
  CurrentStack := 0;
  SetLength(Stack   , LengthTPA * Dist * 2);//Just to be sure ^^.
  SetLength(Lengths , LengthTPA + 1);
  SetLength(TempTPA , LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    TempTPA[I].x := TPA[I].x - x;
    TempTPA[I].y := TPA[I].y - y;
  end;
  For I := 0 to LengthTPA do
    PointsToFill[TempTPA[I].x][TempTPA[I].y] := True;
  For I := 0 to LengthTPA do
    if PointsToFill[TempTPA[I].x][TempTPA[I].y] then
    begin;
      CurrentArray := CurrentArray + 1;
      SetLength(Result,CurrentArray + 1);
      SetLength(Result[CurrentArray],LengthTPA - I + 1);
      fx := TempTPA[I].x;
      fy := TempTPA[I].y;
      CurrentStack := CurrentStack + 1;
      Stack[CurrentStack].x := fx;
      Stack[Currentstack].y := fy;
      While CurrentStack > 0 do
      begin;
        Start:
        if PointsToFill[fx][fy] then
        begin;
          PointsToFill [fx][fy] := false;
          Result[CurrentArray][Lengths[CurrentArray]].x := fx + x;
          Result[CurrentArray][Lengths[CurrentArray]].y := fy + y;
          Lengths[CurrentArray] := Lengths[CurrentArray] + 1;
        end;
        For II := 1 to Dist do
        begin;
          if PointsToFill[fx+II][fy] then
          begin
            fx := fx + II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy+II] then
          begin
            fx := fx;fy := fy + II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy] then
          begin
            fx := fx - II;fy := fy;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx][fy-II] then
          begin
            fx := fx;fy := fy - II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy+II] then
          begin
            fx := fx+II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy-II] then
          begin
            fx := fx-II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx-II][fy + II] then
          begin
            fx := fx-II;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if PointsToFill[fx+II][fy-II] then
          begin
            fx := fx+II;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
          end;
          if II > 1 then
          begin;
            For III := 1 to DistMin do
            begin;
               if PointsToFill[fx+II][fy+III] then
               begin;
                 fx := fx+II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx+II][fy-III] then
               begin;
                 fx := fx+II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto Start;
               end;
               if PointsToFill[fx-II][fy+III] then
               begin;
                 fx := fx-II;fy := fy+III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-II][fy-III] then
               begin;
                 fx := fx-II;fy := fy-III;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;Goto start;
               end;
               if PointsToFill[fx-III][fy+II] then
               begin;
                 fx := fx-III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if  PointsToFill[fx+III][fy+II] then
               begin;
                 fx := fx+III;fy := fy+II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx-III][fy-II] then
               begin;
                 fx := fx-III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
               if PointsToFill[fx+III][fy-II] then
               begin;
                 fx := fx+III;fy := fy-II;CurrentStack := CurrentStack + 1;Stack[CurrentStack].x := fx;Stack[Currentstack].y := fy;goto start;
               end;
            end;
          end;
        end;
        fx := Stack[CurrentStack].x;
        fy := Stack[CurrentStack].y;
        CurrentStack := CurrentStack - 1;
      end;
      SetLength(Result[CurrentArray],Lengths[CurrentArray]);
    end;
  SetLength(Stack,0);
  SetLength(TempTPA,0);
  SetLength(Lengths,0);
end;
Function MergeATPA(ATPA : TPointArrayArray)  : TPointArray;stdcall;
var
  I,II, Len, TempL,CurrentL : integer;
begin;
  Len := High(ATPA);
  CurrentL := 0;
  For I:= 0 to Len do
  begin;
    TempL := High(ATPA[I]) + CurrentL + 1;
    Setlength(Result, TempL+1);
    For II := CurrentL to TempL do
      Result[II] := ATPA[I][II - CurrentL];
    CurrentL := TempL;
  end;
  SetLength(Result,CurrentL);
end;

Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;stdcall;
var
  Bounds : TBox;
  I : Integer;
  x,y,len,width, height,tmp  : integer;
  Points :  Array of Array of Boolean;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  Bounds := GetTPABounds(TPA);
  SetLength(Points,Bounds.x2 - Bounds.x1 + 1,Bounds.y2 - Bounds.y1 + 1);
  SetLength(Result,len + 1);
  Width := Bounds.x2 - Bounds.x1;
  Height := Bounds.y2 - Bounds.y1;
  For I := 0 to Len do
    Points[TPA[I].x - Bounds.x1][TPA[I].y - Bounds.y1] := True;
  I := -1;
//  Showmessage(inttostr(len)+ '-' +inttostr(Width) + '- ' +inttostr(Height) );
  Tmp := 0;
  For Y:= 0 to  Height do
  Begin;
    For x := 0 to Width do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := x + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For X := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  Tmp := 0;
  For x := 0 to Width do
  Begin;
    For y:= 0 to Height do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Tmp := y + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
    For y := Width Downto tmp do
      if Points[x][y] then
      begin;
        Points[x][y] := False;
        I := I + 1;
        Result[I].x := x + bounds.x1;
        Result[I].y := y + Bounds.y1;
        Break;
      end;
  end;
  SetLength(Result, I + 1);
end;
Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Lengths : TIntegerArray;
  Middles : TPointArray;
  TempSorted : TPointArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  if Temp < 1 then Exit;
  SetLength(Middles,Temp);
  SetLength(Lengths,Temp);
  SetLength(TempSorted,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - TempSorted[II].x) < w then
        if Abs(TPA[I].y - TempSorted[II].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      TempSorted[LengthTPA] := Tpa[I];
      Lengths[LengthTPA] := 1;
      Inc(Middles[LengthTPA].x,TPA[I].x);
      Inc(Middles[LengthTPA].y,TPA[I].y);
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      Inc(Middles[II].x,TPA[I].x);
      Inc(Middles[II].y,TPA[I].y);
    end;
  end;
  SetLength(TempSorted,0);
  SetLength(Middles,LengthTPA + 1);
  SetLength(Lengths,LengthTPA + 1);
  SetLength(Result, LengthTPA + 1);
  For I := 0 to LengthTPA do
  begin;
    Result[I].x := Middles[I].x div Lengths[I];
    Result[I].y := Middles[I].y div Lengths[I];
  end;
end;

Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : TPointArrayArray;stdcall;
var
  I,II,L,LL,III : integer;
  TempDist,Temp : Array of TBox;
  SwapTPA : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  L := Length(Points);
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L - 1;
  LL := -1;
  if L < 1 then
    exit;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - W;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - H;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + W;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + H;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Result[II][Counts[II]] := Points[I];
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-W,Points[I].y-H,Points[I].x+W,Points[I].y+H);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
      SetLength(Result,LL+1);
      SetLength(Result[LL],L - I + 1);
      Result[LL][0] := Points[I];
    end;
  end;
  For I := 0 to LL do
    SetLength(Result[I],Counts[I] + 1);
  Bool := True;
  SetLength(TempDist,1);
  While Bool do
  begin;
    Bool := False;
    For I := 0 to LL do
      For II := 0 to (I-1) do
        if ((Temp[I].x1 >= Temp[II].x1) and (Temp[I].x1 <= Temp[II].x2)) or ((Temp[I].x2 >= Temp[II].x1) and (Temp[I].x2 <= Temp[II].x2)) then
          if ((Temp[I].y1 >= Temp[II].y1) and (Temp[I].y1 <= Temp[II].y2)) or ((Temp[I].y2 >= Temp[II].y1) and (Temp[I].y2 <= Temp[II].y2)) then
          begin;
            Bool := True;
            L := Counts[I] + 1;
            Setlength(Result[I], Counts[II] + L+ 1);
            For III := 0 to Counts[II] do
              Result[I][III + L] := Result[II][III];
            Counts[II] := Counts[LL];
            Result[II] := Result[LL];
            Temp[II]   := Temp[LL];
            LL := LL - 1;
            Break;
          end;
  end;
  SetLength(Result,LL+1);
end;

Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : TPointArrayArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
      if Abs(TPA[I].x - Result[II][0].x) < w then
        if Abs(TPA[I].y - Result[II][0].y) < h then
        Begin;
          Bool := False;
          Break;
        end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;


Function GetHBitmap(var CanvasHandle : LongWord) : LongWord; stdcall;
var
  Bmp : Bitmap;
  TempDC : HDC;
begin;
  TempDC := CreateCompatibleDC(CanvasHandle);
  GetObject(GetCurrentObject(CanvasHandle,Obj_Bitmap),Sizeof(bitmap),@Bmp);
  Result := CreateCompatibleBitmap( CanvasHandle,Bmp.bmwidth,bmp.bmHeight);
  SelectObject(TempDC,Result);
end;

Procedure ChangeSize(Width,Height : integer); stdcall;
begin;
  Bmp.Width := Width;
  Bmp.Height := Height;
  ScanLinePointer := Bmp.Scanline[0];
  LineLength := (Longint(Bmp.Scanline[1]) - Longint(ScanLinePointer)) div 4;
end;

Procedure CreateSearchingBitmap(Width,Height : Integer);stdcall;
begin;
  Bmp := TBitmap.Create;
  Bmp.PixelFormat := pf32bit;
  ChangeSize(Width,Height);
end;

function LargestTPAInATPA(ATPA: TpointArrayArray): Integer;stdcall;
var
  I, L, W,Len: Integer;
begin
  Result := -1;
  Len := High(ATPA);
  if Len < 0 then exit;
  L:= Length(ATPA[0]);
  W:= 0;
  for I:= 1 to Len do
    if Length(ATPA[I]) > L then
    begin
      L:= Length(ATPA[I]);
      W:= I;
    end;
  Result := W;
end;

Procedure FreeSearchingBitmap;stdcall;
begin;
  Bmp.free;
  ScanLinePointer := nil;
end;

Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);stdcall;
var
  I,II,LenResult,Len : integer;
  TempColors : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(Counts,Len +1);
  SetLength(TempColors,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if TempColors[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
      LenResult := LenResult + 1;
      TempColors[LenResult] := Colors[I];
    end;
  end;
  SetLength(TempColors,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(TempColors,Counts);
  Colors := TempColors;
end;
Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : TPointArrayArray; stdcall;
Var
  Len, I , II, L : integer;
  Counts : TIntegerArray;
begin;
  Len := High(TPA);
  L := Length(Boxes);
  SetLength(Result, L,Len+1 );
  SetLength(Counts,L);
  Dec(L);
  For I:= 0 to Len do
    For II := 0 to L do
      if (TPA[I].x >= Boxes[II].x1) then
        if (TPA[I].x <= Boxes[II].x2) then
          if (TPA[I].y >= Boxes[II].y1) then
            if (TPA[I].y <= Boxes[II].y2) then
            begin;
              Result[II][Counts[II]] := TPA[I];
              Counts[II] := Counts[II] + 1;
              Break;
            end;
  For I:= 0 to L do
    SetLength(Result[I], Counts[I]);
end;
Function SortTPAToATPADist (Dist : Integer; TPA :TPointArray) : TPointArrayArray;stdcall;
var
  Lengths : TIntegerArray;
  Bool : Boolean;
  Temp,I,II,III,LengthTPA : Integer;
begin;
  Temp := Length(TPA);
  SetLength(Lengths,Temp);
  Temp := Temp - 1;
  LengthTPA := -1;
  For I:= 0 to Temp do
  begin;
    Bool := True;
    For II := 0 to LengthTPA do
    begin;
      For III := 0 to Lengths[II]-1 do
        if sqrt((Result[II][III].x - TPA[I].x) * (Result[II][III].x - TPA[I].x) + (Result[II][III].y - TPA[I].y) * (Result[II][III].y - TPA[I].y)) <= Dist then
        Begin;
          Bool := False;
          Break;
        end;
      if not bool then break;
    end;
    if bool then
    begin;
      LengthTPA := LengthTPA + 1;
      SetLength(Result,LengthTPA+1);
      SetLength(Result[LengthTPA],1);
      Result[LengthTPA][0] := Tpa[I];
      Lengths[LengthTPA] := 1;
    end else
    begin;
      Lengths[II] := Lengths[II] + 1;
      SetLength(Result[II],Lengths[II]);
      Result[II][Lengths[II]-1] := Tpa[I];
    end;
  end;
end;
{
20,042957042957  ms   Mine
180,679320679321 ms   WizzyPlugin
}
Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;stdcall;
var
  Distances : Array of Extended;
  I,Len : Integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  SetLength(Result,Len+1);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
  begin;
    Result[I] := TPA[I];
    Distances[I] := sqrt((x - TPA[I].x) * (x - TPA[I].x) + (y - TPA[I].y) * (y - TPA[I].y));
  end;
  SortTPointArrayE(Distances,Result);
end;

function SortATPADistFirstPoint(x,y : integer ; ATPA : TPointArrayArray) : TPointArrayArray;stdcall;
var
  Distances : Array of Extended;
  I,Len,K,J : Integer;
  H : extended;
begin;
  Len := High(ATPA);
  if Len < 0 then exit;
  SetLength(Result,Len+2);
  SetLength(Distances,Len+1);
  For I:= 0 to Len do
    if High(ATPA[I]) >= 0 then
    begin;
      Result[I] := ATPA[I];
      Distances[I] := sqrt((x - ATPA[I][0].x) * (x - ATPA[I][0].x) + (y - ATPA[I][0].y) * (y - ATPA[I][0].y));
    end;
  k := Len shr 1;
  if k = 0 then
    K := 1;
  while k > 0 do
  begin
    for i := 0 to Len - k do
    begin
      j := i;
      while (j >= 0) and (Distances[j] > Distances[j + k]) do
      begin
        h := Distances[j];
        Result[Len+1] := Result[j];
        Distances[j] := Distances[j + k];
        Result[j] := Result[J + K];
        Result[J+K] := Result[Len+1];
        Distances[j + k] := h;
        if j > k then
          J := J - K
        else
          j := 0;
      end;
    end;
    k := k shr 1;
  end;
  SetLength(Result,Len+1);
end;

function CenterBounds(Arr: TpointArray):Tpoint;stdcall;
var
  Len,xmin,xmax,ymin,ymax, I : Integer;
begin;
  Len := High(Arr);
  if Len < 0 then exit;
  xmin := arr[0].x;
  xmax := arr[0].x;
  ymin := arr[0].y;
  ymax := arr[0].y;
  For I := 1 to Len do
  begin;
    if Arr[I].x < xmin then
      xmin := Arr[I].x
    else if  Arr[I].x > xmax then
      xmax := Arr[I].x;
    if Arr[I].y < ymin then
      ymin := Arr[I].y
    else if  Arr[I].y > ymax then
      ymax := Arr[I].y;
  end;
  Result.x := Round((xmin + xmax) / 2);
  Result.y := Round((ymin + ymax) / 2);
end;

function MiddlePT(P1, P2: TPoint): TPoint;stdcall;
begin
  result.x:= (P1.x + P2.x) div 2;
  result.y:= (P1.y + P2.y) div 2;
end;
Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray); stdcall;
var
  Len : integer;
  XCount,YCount : integer;
  I : integer;
begin;
  Len := High(TPA);
  if Len < 0 then exit;
  XCount := 0;
  YCount := 0;
  For I:= 0 to Len do
  begin;
    XCount := XCount + TPA[I].x;
    YCount := YCount + TPA[I].y;
  end;
  X := XCount div (Len + 1);
  Y := YCount div (Len + 1);
end;

function CenterATPA(ATPA : TPointArrayArray) : TPointArray;stdcall;
var
  XCount,YCount : int64;
  I,II,L,LL : integer;
begin;
  L := High(ATPA);
  SetLength(Result,L+1);
  For I:= 0 to L do
  begin;
    LL := High(ATPA[I]);
    XCount := 0;
    YCount := 0;
    For II := 0 to LL do
    begin;
      XCount := XCount + ATPA[I][II].x;
      YCount := YCount + ATPA[I][II].y;
    end;
    result[I].x:= XCount div (LL+1);
    result[I].y:= YCount div (LL+1);
  end;
end;

function CenterTPA(TPA: TPointArray): TPoint;stdcall;
var
  l, xCount, yCount: Int64;
  i: integer;
begin
  L := High(TPA);
  xCount:= 0;
  yCount:= 0;
  for i:= 0 to L do
  begin
    xCount:= xCount + TPA[I].x;
    yCount:= yCount + TPA[I].y;
  end;
  result.x:= xCount div (L+1);
  result.y:= yCount div (L+1);
end;

Function SortColors( Colors : TIntegerArray): TIntegerArray;stdcall;
var
  I,II,LenResult,Len : integer;
  Counts : TIntegerArray;
  Found : Boolean;
begin
  Len := High(Colors);
  SetLength(counts,Len +1);
  SetLength(result,Len+1);
  LenResult := -1;
  For I:= 0 to Len do
  begin;
    Found := False;
    For II := 0 to LenResult do
      if Result[II] = Colors[I] then
      begin;
        Found := True;
        Counts[II] := Counts[II] + 1;
      end;
    if Not found then
    begin;
          LenResult := LenResult + 1;
      Result[LenResult] := Colors[I];
    end;
  end;
  SetLength(Result,LenResult+1);
  SetLength(Counts,LenResult+1);
  SortColorsCount(Result,Counts);
end;

Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);stdcall;
var
  TempR,TempG,TempB,Tempx,tempy,tempz : double;
begin;
  Tempx := X / 100;
  tempy := Y / 100;
  tempz := Z / 100;

  TempR := Tempx *  3.2406 + tempy * -1.5372 + tempz * -0.4986;
  TempG := Tempx * -0.9689 + tempy *  1.8758 + tempz *  0.0415;
  TempB := Tempx *  0.0557 + tempy * -0.2040 + tempz *  1.0570;

  if TempR > 0.0031308  then
    TempR := 1.055 * ( Power(TempR, ( 1 / 2.4 )) ) - 0.055
  else
    TempR := 12.92 * TempR;
  if TempG > 0.0031308 then
    TempG := 1.055 * ( Power(TempG, ( 1 / 2.4 )) ) - 0.055
  else
    TempG := 12.92 * TempG;
  if  TempB > 0.0031308 then
    TempB := 1.055 * ( Power(TempB , ( 1 / 2.4 )) ) - 0.055
  else
    TempB := 12.92 * TempB;

  R := Round(TempR * 255);
  G := Round(TempG * 255);
  B := Round(TempB * 255);
end;

Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);stdcall;
var
  Red,Green,Blue : double;
begin;
  Red := R / 255;
  Green := G / 255;
  Blue := B / 255;
  if Red > 0.04045  then
    Red := Power( ( Red + 0.055 ) / 1.055  , 2.4)
  else
    Red := Red / 12.92;
  if Green > 0.04045  then
    Green := Power( ( Green + 0.055 ) / 1.055 , 2.4)
  else
    Green := Green / 12.92;
  if  Blue > 0.04045 then
    Blue := Power(  ( Blue + 0.055 ) / 1.055  , 2.4)
  else
    Blue := Blue / 12.92;

  Red := Red * 100;
  Green := Green * 100;
  Blue := Blue * 100;
  X := Red * 0.4124 + Green * 0.3576 + Blue * 0.1805;
  Y := Red * 0.2126 + Green * 0.7152 + Blue * 0.0722;
  Z := Red * 0.0193 + Green * 0.1192 + Blue * 0.9505;
end;

Procedure RGBToHSLRay(RR,GG,BB : integer;var H,S,L : Double);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Double;

begin
  R := RR / 255;
  G := GG / 255;
  B := BB / 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := 0.5 * (Cmax + Cmin);
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 0.5 then
      S := D / (Cmax + Cmin)
    else
      S := D / (2 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) / D
    else
      if G = Cmax then
        H  := 2 + (B - R) / D
      else
        H := 4 +  (R - G) / D;
    H := H / 6;
    if H < 0 then
      H := H + 1;
  end;
end;
Procedure RGBToHSLRayInt(RR,GG,BB : integer;var H,S,L : Integer);stdcall;
var
  R,  G,  B,   D,  Cmax, Cmin: Integer;

begin
  R := RR * 10000 div 255;
  G := GG * 10000 div 255;
  B := BB * 10000 div 255;
  CMin := R;
  if G < Cmin then Cmin := G;
  if B  < Cmin then Cmin := B;
  CMax := R;
  if G > Cmax then Cmax := G;
  if B  > Cmax then Cmax := B;
  L := (Cmax + Cmin) div 2;
  if Cmax = Cmin then
  begin
    H := 0;
    S := 0;
  end else
  begin;
    D := Cmax - Cmin;
    if L < 5000 then
      S := D div (Cmax + Cmin)
    else
      S := D div (20000 - Cmax - Cmin);
    if R = Cmax then
      H := (G - B) div D
    else
      if G = Cmax then
        H  := 20000 + (B - R) div D
      else
        H := 40000 +  (R - G) div D;
    H := H div 60000;
    if H < 0 then
      H := H + 10000;
  end;
end;

Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);stdcall;
begin;
  C := 1 - R / 255;
  M := 1 - G / 255;
  Y := 1 - B / 255;
  K := 1;
  if ( C < 1 ) then  K := C;
  if ( M < K ) then  K := M;
  if ( Y < K ) then  K := Y;
  if K = 1  then
  begin;
     C := 0;
     M := 0;
     Y := 0;
  end else
  begin;
     C:= ( C - K ) / ( 1 - K );
     M:= ( M - K ) / ( 1 - K );
     Y:= ( Y - K ) / ( 1 - K );
  end;
end;

Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  CC,  MC,  YC, KC ,  TmpC,TmpM,TmpY ,TmpK: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToCMYKRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),CC,MC,YC,KC);
  CTol := CTol / 100;
  MTol := MTol / 100;
  YTol := YTol / 100;
  KTol := KTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TmpC := 1 - (ScanLinePointer[x].R / 255);
      TmpM := 1 - (ScanLinePointer[x].G / 255);
      TmpY := 1 - (ScanLinePointer[x].B / 255);
      TmpK := 1;
      if  TmpC < 1     then  TmpK := TmpC;
      if  TmpM < TmpK  then  TmpK := TmpM;
      if  TmpY < TmpK  then  TmpK := TmpY;
      if Abs(KC - TmpK) <= KTol then
      begin;
        if TmpK = 1  then
        begin;
          if (CC <= CTol) then
            if (MC <= MTol) then
              if (YC <= YTol) then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end else
        begin;
          if Abs((TmpC - TmpK) / (1 - TmpK) - CC) <= CTol then
            if Abs(( TmpM - TmpK ) / ( 1 - TmpK)  - MC) <= MTol then
              if Abs(( TmpY - TmpK ) / ( 1 -  TmpK) - YC) <= YTol then
              begin;
                Len := Len + 1;
                Points[Len].x := x-Startnum+xs;
                Points[Len].y := y+ys;
              end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Integer;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRayInt((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
{  HTol := HTol * 100;
  STol := STol * 100;
  LTol := LTol * 100;}
  H := H div 100;
  S := S div 100;
  L := L div 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R * 100 div 255);
      TempG := (ScanLinePointer[x].G * 100 div 255);
      TempB := (ScanLinePointer[x].B * 100 div 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := (CMax + CMin) div 2;
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 50 then
            TmpS := D div (Cmax + Cmin)
          else
            TmpS := D div (200 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) div D
            else
            if TempG = Cmax then
              TmpH  := 200 + (TempB - TempR) div D
            else
              TmpH := 400 +  (TempR - TempG) div D;
            TmpH := TmpH div 600;
            if TmpH < 0 then
              TmpH := TmpH + 100;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;
Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  H,  S,  L,TempR,TempG,TempB,  TmpH,TmpS,TmpL , D,  Cmax, Cmin: Double;
begin
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  RGBToHSLRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),H,S,L);
  HTol := HTol / 100;
  STol := STol / 100;
  LTol := LTol / 100;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      CMin := TempR;
      CMax := TempR;
      if TempG  < Cmin then CMin := TempG;
      if TempB  < Cmin then CMin := TempB;
      if TempG  > Cmax then CMax := TempG;
      if TempB  > Cmax then CMax := TempB;
      TmpL := 0.5 * (CMax + CMin);
      if Abs(L - TmpL) <= LTol then
      begin;
        if Cmax = Cmin then
        begin
          if (H <= HTol) and (S <= STol) then
          begin;
            Len := Len + 1;
            Points[Len].x := x-Startnum+xs;
            Points[Len].y := y+ys;
          end;
        end else
        begin;
          D := Cmax - Cmin;
          if Tmpl < 0.5 then
            TmpS := D / (Cmax + Cmin)
          else
            TmpS := D / (2 - Cmax - Cmin);
          if Abs(S - TmpS) <= STol then
          begin;
            if TempR = Cmax then
              TmpH := (TempG - TempB) / D
            else
            if TempG = Cmax then
              TmpH  := 2 + (TempB - TempR) / D
            else
              TmpH := 4 +  (TempR - TempG) / D;
            TmpH := TmpH / 6;
            if TmpH < 0 then
              TmpH := TmpH + 1;
            if Abs(H - TmpH) <= HTol then
            begin;
              Len := Len + 1;
              Points[Len].x := x-Startnum+xs;
              Points[Len].y := y+ys;
            end;
          end;
        end;
      end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;stdcall;
var
  Len,X,Y,Width,Height,StartNum,EndNum: integer;
  OX,  OY,  OZ,TempR,TempG,TempB : Double;
begin
  RGBToXYZRay((Color and $ff),(Color shr 8 and $ff),(Color shr 16 and $ff),OX,OY,OZ);
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  Len := -1;
  Width := Xe - Xs + 1;
  Height := Ye - Ys + 1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Width,Height, DC, xs, ys, SRCCOPY);
  SetLength(Points,(Width * Height));
  Width := Xe - Xs;
  Height := Ye - Ys;
  For Y := 0 to Height do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + Width;
    For x := StartNum to EndNum do
    begin;
      TempR := (ScanLinePointer[x].R / 255);
      TempG := (ScanLinePointer[x].G / 255);
      TempB := (ScanLinePointer[x].B / 255);
      if TempR > 0.04045  then
       TempR := Power( ( TempR + 0.055 ) / 1.055  , 2.4)
      else
       TempR := TempR / 12.92;
      if TempG > 0.04045  then
        TempG := Power( ( TempG + 0.055 ) / 1.055 , 2.4)
      else
        TempG := TempG / 12.92;
      if  TempB > 0.04045 then
        TempB := Power(  ( TempB + 0.055 ) / 1.055  , 2.4)
      else
        TempB := TempB / 12.92;
      TempR := TempR * 100;
      TempG := TempG * 100;
      TempB := TempB * 100;
      if Abs((TempR * 0.4124 + TempG * 0.3576 + TempB * 0.1805) - OX) <= XTol then
        if Abs((TempR * 0.2126 + TempG * 0.7152 + TempB * 0.0722) - OY) <= YTol then
          if Abs((TempR * 0.0193 + TempG * 0.1192 + TempB * 0.9505) - OZ) <= ZTol then
          begin;
            Len := Len + 1;
            Points[Len].x := x-startnum+xs;
            Points[Len].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,Len+1);
  Result := Len+1;
end;

Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,StartNum,EndNum: integer;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      if Abs(ScanLinePointer[x].R - R) <= RTol then
        if Abs(ScanLinePointer[x].G - G) <= GTol then
          if Abs(ScanLinePointer[x].B - B) <= BTol then
          begin;
            L := L + 1;
            Points[L].x := x-startnum+xs;
            Points[L].y := y+ys;
          end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;

Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;stdcall;
var
  L,X,Y,W,H,TmpR,TmpG,TmpB ,StartNum,EndNum: integer;
  Tol : Extended;
  R,G,B : Byte;
begin;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L := -1;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, W,H, DC, xs, ys, SRCCOPY);
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  Tol := (RTol + GTol + BTol) / 3;
  SetLength(Points,(W * H));
  W := W-1;
  H := H-1;
  For Y := 0 to H do
  begin;
    StartNum := Y*LineLength;
    EndNum := StartNum + w;
    For x := StartNum to EndNum do
    begin;
      TmpR := Abs(ScanLinePointer[x].R - R);
      if TmpR <= RTol then
      begin;
        TmpG := Abs(ScanLinePointer[x].G - G);
        if TmpG <= GTol then
        begin;
          TmpB := Abs(ScanLinePointer[x].B - B);
          if TmpB <= BTol then
            if sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= Tol then
            begin;
              L := L + 1;
              Points[L].x := x-Startnum+xs;
              Points[L].y := y+ys;
            end;
        end;
      end;
    end;
  end;
  SetLength(Points,L+1);
  Result := L + 1;
end;
Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;Stdcall;
var
  x,y,L,LL : Integer;
  Bmp : Windows.TBitmap;
  Bitmappie : TBitmap;
  HBmp : Windows.HBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
begin;
  HBmp := GetCurrentObject(BmpDC,OBJ_BITMAP);
  GetObject(HBmp,SizeOf(Bmp),@Bmp);
  Bitmappie := TBitmap.Create;
  Bitmappie.PixelFormat := pf32bit;
  Bitmappie.Width := Bmp.bmWidth;
  Bitmappie.Height := Bmp.bmHeight;
  SetLength(Result.WhiteArray,Bmp.bmWidth * Bmp.bmHeight);
  SetLength(Result.BlackArray,Bmp.bmWidth * Bmp.bmHeight);
  BitBlt(Bitmappie.Canvas.Handle, 0, 0, Bmp.bmWidth,Bmp.bmHeight, BmpDC, 0, 0, SRCCOPY);
  ScanLine := Bitmappie.Scanline[0];
  LengthLine := (Longint(Bitmappie.Scanline[1]) - Longint(ScanLine)) div 4;
  L := -1;
  LL := -1;
  Bmp.bmWidth := Bmp.bmWidth - 1;
  Bmp.bmHeight := Bmp.bmHeight - 1;
  Result.Width := Bmp.bmWidth;
  Result.Height := Bmp.bmHeight;
  For y := 0 to Bmp.bmHeight do
    For x := 0 to Bmp.bmWidth do
    begin;
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        L := L + 1;
        Result.WhiteArray[L].x := x;
        Result.WhiteArray[L].y := y;
      end else
      begin;
        LL := LL + 1;
        Result.BlackArray[LL].x := x;
        Result.BlackArray[LL].y := y;
      end;
  end;
  SetLength(Result.WhiteArray,L + 1);
  SetLength(Result.BlackArray,LL + 1);
  Result.CheckPoint := Result.BlackArray[LL];
  For x := 0 to Bmp.bmWidth do
    For Y := 0 to Bmp.bmHeight do
      if Scanline[y * LengthLine + x].r = 255 then
      begin;
        Result.xOff := x;
        Result.yOff := y;
        Bitmappie.Free;
        Exit;
      end;
end;

Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;stdcall;
var
  PrecalcedNumbers : TIntegerArray;
  L,LL,X,Y,W,H,I,II,TmpR,TmpG,TmpB ,StartNum: integer;
  R,G,B,RR,GG,BB : Byte;
  Bmp : TBitmap;
  LengthLine : LongInt;
  ScanLine : PRGB32Array;
  StartPT : TPoint;
Label
  NoMatch;
begin;
  Result := False;
  Bmp := TBitmap.Create;
  Bmp.PixelFormat := pf32bit;
  if xs < 0 then
    xs := 0;
  if ys < 0 then
    ys := 0;
  L  := High(Mask.WhiteArray);
  LL := High(Mask.BlackArray);
  if L = 0 then exit;
  W := Xe - Xs+1;
  H := Ye - Ys+1;
  Bmp.Width := W;
  Bmp.Height:= H;
  BitBlt(Bmp.Canvas.Handle, 0, 0,W,H, ClientDC, xs, ys, SRCCOPY);
  ScanLine := Bmp.Scanline[0];
  LengthLine := (Longint(Bmp.Scanline[1]) - Longint(ScanLine)) div 4;
  SetLength(PrecalcedNumbers,H);
  For I := 0 to (H - 1) do
    PrecalcedNumbers[I] := I * LengthLine;
  W := W-Mask.Width-1;
  H := H-Mask.Height-1;
  For Y := Mask.yOff to H do
    For x := Mask.xOff to W do
    begin;
      R := ScanLine[PrecalcedNumbers[Y] + x].r;
      G := ScanLine[PrecalcedNumbers[Y] + x].g;
      B := ScanLine[PrecalcedNumbers[Y] + x].b;
      StartPT.x := x - Mask.xOff;
      StartPT.y := y - Mask.yOff;
      StartNum := PrecalcedNumbers[ Mask.CheckPoint.y + StartPT.y] + Mask.CheckPoint.x + StartPT.x;
      if sqrt((ScanLine[StartNum].R - R) * (ScanLine[StartNum].R - R)
             +(ScanLine[StartNum].G - G) * (ScanLine[StartNum].G - G)
             +(ScanLine[StartNum].B - B) * (ScanLine[StartNum].B - B)) <= ContourTol then
               Continue;
      For I := 0 to L do
      begin;
        StartNum := PrecalcedNumbers[Mask.WhiteArray[I].y + StartPT.y] + StartPT.x + Mask.WhiteArray[I].x;
        TmpR := ScanLine[StartNum].R - R;
        TmpG := ScanLine[StartNum].G - G;
        TmpB := ScanLine[StartNum].B - B;
        if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) > Tol) then
          Goto NoMatch;
        if BackgroundAllColors then
        begin;
          RR := ScanLine[StartNum].R;
          GG := ScanLine[StartNum].G;
          BB := ScanLine[StartNum].B;
          For II := 0 to LL do
          begin;
            StartNum := PrecalcedNumbers[Mask.BlackArray[II].y + StartPT.y] + StartPT.x + Mask.BlackArray[II].x;
            TmpR := ScanLine[StartNum].R - RR;
            TmpG := ScanLine[StartNum].G - GG;
            TmpB := ScanLine[StartNum].B - BB;
            if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
              goto NoMatch;
          end;
        end;
      end;
      if not BackgroundAllColors then
        For I := 0 to LL do
        begin;
          StartNum := PrecalcedNumbers[Mask.BlackArray[I].y + StartPT.y] + StartPT.x + Mask.BlackArray[I].x;
          TmpR := ScanLine[StartNum].R - R;
          TmpG := ScanLine[StartNum].G - G;
          TmpB := ScanLine[StartNum].B - B;
          if (sqrt( Tmpr * Tmpr + Tmpg * tmpg + tmpb * tmpb) <= ContourTol) then
            goto NoMatch;
        end;
      Result := True;
      mx :=  x+xs-Mask.xOff;
      my :=  y+ys-Mask.yOff;
      Bmp.Free;
      ScanLine := Nil;
      Exit;
      NoMatch:
  end;
  Bmp.Free;
  Scanline := nil;
end;

Function IsMaskAt(x,y : integer; mask : TMaskRay; Tol,ContourTol : Integer; Bmp : TBitmap) : Boolean;
var
  I, II : integer;
begin;
end;

{Function FindRocks(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray;Color,RTol,GTol,BTol,xs, ys, xe, ye : Integer; DC : LongWord) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  R,G,B : Byte;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
  Bmp : TBitmap;
  Line : PRGB32Array;
begin;
  Result := False;
  L := -1;
  Bmp := TBitmap.Create;
  Bmp.Width := xe - xs+1;
  Bmp.Height := ye - ys+1;
  BitBlt(Bmp.Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, DC, xs, ys, SRCCOPY);
  Bmp.PixelFormat := pf32bit;
  R := Color and $ff;
  G := Color shr 8 and $ff;
  B := Color shr 16 and $ff;
  SetLength(TempPoints,(Bmp.Width * Bmp.Height));
  I := Bmp.Height-1;
  II := Bmp.Width-1;
  for y := 0 to I do
  begin
    Line := Bmp.ScanLine[y];
    for x := 0 to II do
    begin
      if (Abs(Line[x].R - R) <= RTol) then
        if (Abs(Line[x].G - G) <= GTol) then
          if (Abs(Line[x].B - B) <= Btol) then
          begin
            L := L + 1;
            TempPoints[L].x := x+xs;
            TempPoints[L].y := y+ys;
         end;
    end;
  end;
  L := L + 1;
  SetLength(TempPoints,L);
  Line := nil;
  Bmp.Free;
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L -1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (TempPoints[I].x >= TempDist[II].x1) and (TempPoints[I].x <= TempDist[II].x2) then
        if (TempPoints[I].y >= TempDist[II].y1) and (TempPoints[I].y <= TempDist[II].y2) then
        begin;
          if (TempPoints[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := TempPoints[I].x;
            TempDist[II].x1 := TempPoints[I].x - PointsDist;
          end;
          if (TempPoints[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := TempPoints[I].y;
            TempDist[II].y1 := TempPoints[I].y - PointsDist;
          end;
          if (TempPoints[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := TempPoints[I].x;
            TempDist[II].x2 := TempPoints[I].x + PointsDist;
          end;
          if (TempPoints[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := TempPoints[I].y;
            TempDist[II].y2 := TempPoints[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(TempPoints[I].x-PointsDist,TempPoints[I].y-PointsDist,TempPoints[I].x+PointsDist,TempPoints[I].y+PointsDist);
      Temp[LL] := TempDist[LL];
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;    }


Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);stdcall;
var
  Dump : Array[0..9] of TIntegerArray; //We store them temporary here
  Counts : Array[0..9] of Integer; //Counts, for the length of the Dump
  Len,Divider,I,II,III,Temporary,Counter : Integer;
  TotalCleaning,TotalDump,TotalBack,TotalInit,Temp,Destroy : integer;
begin
  Divider := 1; //We use this, to sort all the digits time by time ;).
  Len := High(Integers);
  TotalDump := 0;
  TotalCleaning := 0;
  TotalBack := 0;
  TotalInit := 0;
  Temp := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],Len + 1);
  TotalInit := TotalInit + GetTickCount - Temp;
  For I := 1 to Digits do //Digits!
  begin;
    Temp := GetTickCount;
    For II := 0 to 9 do
      Counts[II] := -1; //Reset the counts
    TotalCleaning := TotalCleaning + GetTickCount - Temp;
    Temp := GetTickCount;
    For II := 0 to Len do
    begin;
      Temporary := (Integers[II] div Divider) mod 10; // We get the single digit of the number..
      //Counts[Temporary] := Counts[Temporary] + 1; //Increase the Counts ;)
      Inc(Counts[Temporary]);
      Dump[Temporary][Counts[Temporary]] := Integers[II]; //Store the whole number in in its own digit 'dump', 0 to Radix - 1.. E.G. : Dump[0][0] := Integers[II];
    end;
    TotalDump := TotalDump + GetTickCount - Temp;
    Temp := GetTickCount;
    Counter := -1;
    For II := 0 to 9 do
      For III := 0 to  Counts[II] do
      begin;
        Inc(Counter);//Counter := Counter + 1;
        Integers[Counter] := Dump[II][III]; //Place back the orignal var, "Integers"
      end;
    TotalBack := TotalBack + GetTickCount - Temp;
    Divider := Divider * 10; //So that we go to the next Digit
  end;
  Writeln(inttostr(TotalCleaning) + ' Cleaning');
  Writeln(inttostr(TotalDump) + ' Dump');
  Writeln(inttostr(TotalBack) + ' Back');
  Writeln(inttostr(TotalInit) + ' Init');
  Destroy := GetTickCount;
  For I := 0 to 9 do
    SetLength(Dump[I],0);
  Writeln(IntToStr(GetTickCount - Destroy) + ' DeInit');

end;



procedure QuickSort(var arr: TIntegerArray; s, e: integer); stdcall;
var
  cs, ce: Integer;
  pivot, swap: INteger;
begin
  cs:= s;
  ce:= e;
  pivot:= arr[(s + e) div 2];
  repeat
    while arr[cs] < pivot do cs:= cs + 1;
    while arr[ce] > pivot do ce:= ce - 1;
    if cs <= ce then
    begin
      swap:= arr[cs];
      arr[cs]:= arr[ce];
      arr[ce]:= swap;
      cs:= cs + 1;
      ce:= ce - 1;
    end;
  until cs > ce;
  if ce > s then QuickSort(arr, s, ce);
  if cs < e then QuickSort(arr, cs, e);
end;
Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);stdcall;
var
  I : integer;
begin;
  SetLength(Ints,Len+1);
  For I := 0 to len do
    INts[I] := Random(PlusRandom);
  if MinRandom > 0 then
  For I := 0 to len do
    Ints[I] := Ints[I] - Random(MinRandom);
end;
Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;stdcall;
var
  I,II,L,LL,X,Y : integer;
  TempDist,Temp : Array of TBox;
  TempPoints,TempPoints2 : TPointArray;
  Counts : TIntegerArray;
  Bool : Boolean;
begin;
  Result := False;
  L := Length(Points);
  if L < 2 then Exit;
  SetLength(Temp,L);
  SetLength(TempDist,L);
  SetLength(Counts,L);
  L := L - 1;
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := LL downto 0 do
      if (Points[I].x >= TempDist[II].x1) and (Points[I].x <= TempDist[II].x2) then
        if (Points[I].y >= TempDist[II].y1) and (Points[I].y <= TempDist[II].y2) then
        begin;
          if (Points[I].x < Temp[II].x1) then
          begin;
            Temp[II].x1 := Points[I].x;
            TempDist[II].x1 := Points[I].x - PointsDist;
          end;
          if (Points[I].y < Temp[II].y1) then
          begin;
            Temp[II].y1 := Points[I].y;
            TempDist[II].y1 := Points[I].y - PointsDist;
          end;
          if (Points[I].x > Temp[II].x2) then
          begin;
            Temp[II].x2 := Points[I].x;
            TempDist[II].x2 := Points[I].x + PointsDist;
          end;
          if (Points[I].y > Temp[II].y2) then
          begin;
            Temp[II].y2 := Points[I].y;
            TempDist[II].y2 := Points[I].y + PointsDist;
          end;
          Bool := True;
          Counts[II] := Counts[II] + 1;
          Break;
        end;
    if not Bool then
    begin;
      LL := LL + 1;
      TempDist[LL] := IntToBox(Points[I].x-PointsDist,Points[I].y-PointsDist,Points[I].x+PointsDist,Points[I].y+PointsDist);
      Temp[LL] := IntToBox(Points[I].x,Points[I].y,Points[I].x,Points[I].y);
    end;
  end;
  if LL < 0 then exit;
  SetLength(TempDist,0);
  SetLength(TempPoints,LL+1);
  SetLength(Counts,LL+1);
  For I:= 0 to LL do
  begin;
    TempPoints[I].x := (Temp[I].x1 + Temp[I].x2) div 2;
    TempPoints[I].y := (Temp[I].y1 + Temp[I].y2) div 2;
  end;
  SetLength(Temp,0);
  SortTPointArray(Counts,TempPoints);
  SetLength(TempPoints2,LL+1);
  L := -1;
  For I:= LL downto 0 do
  begin;
    Bool := False;
    For II := 0 to L do
      if (Abs(TempPoints[I].x - TempPoints2[II].x) <= BoxDist) and (Abs(TempPoints[I].y - TempPoints2[II].y) <= BoxDist) then
      begin;
        TempPoints2[II].x := (TempPoints2[II].x + TempPoints[I].x) div 2;
        TempPoints2[II].y := (TempPoints2[II].y + TempPoints[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      L := L + 1;
      TempPoints2[L] := TempPoints[I];
    end;
  end;
  if L < 0 then exit;
  SetLength(TempPoints2,L+1);
  SetLength(Points,L+1);
  LL := -1;
  For I:= 0 to L do
  begin;
    Bool := False;
    For II := 0 to LL do
      if (Abs(TempPoints2[I].x - Points[II].x) <= LastBoxDist) and (Abs(TempPoints2[I].y - Points[II].y) <= LastBoxDist) then
      begin;
        Points[II].x := (TempPoints2[II].x + Points[I].x) div 2;
        Points[II].y := (TempPoints2[II].y + Points[I].y) div 2;
        Bool := True;
        Break;
      end;
    if Not Bool then
    begin;
      LL := LL + 1;
      Points[LL] := TempPoints2[I];
    end;
  end;
  if LL < 0 then
    exit
  else
    Result := True;
  SetLength(Points,LL+1);
end;

function GetFunctionCount(): Integer; stdcall; export;
begin
  Result := 54;
end;

function GetFunctionInfo(x: Integer; var ProcAddr: Pointer; var ProcDef: PChar): Integer; stdcall;
begin
  case x of
    0:
       begin;
         ProcAddr := @RemoveTPADistEachother;
         StrPCopy(ProcDef, 'Function RemoveTPADistEachother(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    1:
       begin;
         ProcAddr := @FindRocksOld;
         StrPCopy(ProcDef, 'Function FindRocksOld(PointsDist,BoxDist,LastBoxDist : Integer;var Points : TPointArray) : Boolean;');
       end;
    2:
       begin;
         ProcAddr := @FindColorsRay;
         StrPCopy(ProcDef, 'Function FindColorsRay(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    3:
       begin;
         ProcAddr := @GetHBitmap;
         StrPCopy(ProcDef, 'Function GetHBitmap(CanvasHandle : LongWord) : LongWord;');
       end;
    4:
       begin;
         ProcAddr := @ChangeSize;
         StrPCopy(ProcDef, 'Procedure ChangeSize(Width,Height : integer);');
       end;
    5:
       begin;
         ProcAddr := @FreeSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure FreeSearchingBitmap;');
       end;
    6:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    7:
       begin;
         ProcAddr := @RGBToHSLRay;
         StrPCopy(ProcDef, ' Procedure RGBToHSLRay(R,G,B : integer;var H,S,L : double);');
       end;
    8:
       begin;
         ProcAddr := @CreateSearchingBitmap;
         StrPCopy(ProcDef, 'Procedure CreateSearchingBitmap(Width,Height : Integer);');
       end;
    9:
       begin;
         ProcAddr := @FindColorsHSL;
         StrPCopy(ProcDef, 'Function FindColorsHSL(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    10:
       begin;
         ProcAddr := @SortColors;
         StrPCopy(ProcDef, 'Function SortColors( Colors : TIntegerArray): TIntegerArray;');
       end;
    11:
       begin;
         ProcAddr := @SortColorsSaveCounts;
         StrPCopy(ProcDef, 'Procedure SortColorsSaveCounts(var Colors,Counts: TintegerArray);');
       end;
    12:
       begin;
         ProcAddr := @SortTPAMiddles;
         StrPCopy(ProcDef, 'Function SortTPAMiddles ( w,h : integer; TPA : TPointArray) : TPointArray;');
       end;
    13:
       begin;
         ProcAddr := @SortTPAToATPA;
         StrPCopy(ProcDef, 'Function SortTPAToATPA (w,h : integer; TPA : TPointArray) : TPointArrayArray;');
       end;
    14:
       begin;
         ProcAddr := @BoxTPAToATPA;
         StrPCopy(ProcDef, 'Function BoxTPAToATPA(w,h : integer; Points : TPointArray) : TpointArrayArray;');
       end;
    15:
       begin;
         ProcAddr := @GetTPABounds;
         StrPCopy(ProcDef, 'Function GetTPABounds(TPA: TPointArray): TBox;');
       end;
    16:
       begin;
         ProcAddr := @FloodFillTPA;
         StrPCopy(ProcDef, 'Function FloodFillTPA(TPA : TPointArray) : TPointArrayArray;');
       end;
    17:
       begin;
         ProcAddr := @FloodFillTPADistance;
         StrPCopy(ProcDef, 'Function FloodFillTPADistance(Dist : Integer; TPA : TPointArray) : TPointArrayArray;');
       end;
    18:
       begin;
         ProcAddr := @FindCommonPoint;
         StrPCopy(ProcDef, 'Function FindCommonPoint(ArrayTPA : TPointArrayArray) : TPointArray;');
       end;
    19:
       begin;
         ProcAddr := @FindColorsXYZ;
         StrPCopy(ProcDef, 'Function FindColorsXYZ(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;XTol,YTol,ZTol : Double;const DC : LongWord) : Integer;');
       end;
    20:
       begin;
         ProcAddr := @RGBToXYZRay;
         StrPCopy(ProcDef, 'Procedure RGBToXYZRay(R,G,B : integer;var x,y,z : double);');
       end;
    21:
       begin;
         ProcAddr := @XYZToRGBRay;
         StrPCopy(ProcDef, 'Procedure XYZToRGBRay(X,Y,Z : Double;var R,G,B: integer);');
       end;
    22:
       begin;
         ProcAddr := @LargestTPAInATPA;
         StrPCopy(ProcDef, 'function LargestTPAInATPA(ATPA: TPointArrayArray): Integer;');
       end;
    23:
       begin;
         ProcAddr := @RemoveTPASameRange;
         StrPCopy(ProcDef, 'Function RemoveTPASameRange(Dist : Integer; TPA : TPointArray) : TPointArray;');
       end;
    24:
       begin;
         ProcAddr := @FindTPAEdgePoints;
         StrPCopy(ProcDef, 'Function FindTPAEdgePoints ( MaxW,MaxH : integer; TPA : TPointArray): TPointArray;');
       end;
    25:
       begin;
         ProcAddr := @RGBToCMYKRay;
         StrPCopy(ProcDef, 'Procedure RGBToCMYKRay(R,G,B : integer;var C,M,Y,K : Double);');
       end;
    26:
       begin;
         ProcAddr := @FindColorsCMYK;
         StrPCopy(ProcDef, 'Function FindColorsCMYK(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;CTol,MTol,YTol,KTol : Double;const DC : LongWord) : Integer;');
       end;
    27:
       begin;
         ProcAddr := @SortTPABoxes;
         StrPCopy(ProcDef, 'Function SortTPABoxes( Boxes : TBoxArray; TPA: TPointArray) : TPointArrayArray;');
       end;
    28:
       begin;
         ProcAddr := @SortTPADistance;
         StrPCopy(ProcDef, 'Function SortTPADistance(x,y : integer; TPA : TPointArray) : TPointArray;');
       end;
    29:
       begin;
         ProcAddr := @FindColorsRGB;
         StrPCopy(ProcDef, 'Function FindColorsRGB(var Points : TPointArray;const Color,RTol,GTol,BTol: integer; xs, ys : integer; const xe, ye : Integer;const DC : LongWord) : Integer;');
       end;
    30:
       begin;
         ProcAddr := @CenterTPA;
         StrPCopy(ProcDef, 'function CenterTPA(TPA: TPointArray): TPoint;');
       end;
    31:
       begin;
         ProcAddr := @CenterBounds;
         StrPCopy(ProcDef, 'function CenterBounds(Arr: TpointArray):Tpoint;');
       end;
    32:
       begin;
         ProcAddr := @MiddlePT;
         StrPCopy(ProcDef, 'function MiddlePT(P1, P2: TPoint): TPoint;');
       end;
    33:
       begin;
         ProcAddr := @MergeATPA;
         StrPCopy(ProcDef, 'Function MergeATPA(ATPA : TPointArrayArray)  : TPointArray;');
       end;
    34:
       begin;
         ProcAddr := @AbsoluteInt;
         StrPCopy(ProcDef, 'Function AbsoluteInt ( SomeNumber : integer) : integer;');
       end;
    35:
       begin;
         ProcAddr := @ColorToRGBASM;
         StrPCopy(ProcDef, 'Function ColorToRGBASM( Color : integer;var R,G,B : integer):integer;');
       end;
    36:
       begin;
         ProcAddr := @FindColorsHSLInt;
         StrPCopy(ProcDef, 'Function FindColorsHSLInt(var Points : TPointArray;Color, xs, ys, xe, ye : Integer;HTol,STol,LTol : Double;const DC : LongWord) : Integer;');
       end;
    37:
       begin;
         ProcAddr := @CleanATPA;
         StrPCopy(ProcDef, 'Procedure CleanATPA(MinLength,MaxLength : Integer; var ATPA : TPointArrayArray);');
       end;
    38:
       begin;
         ProcAddr := @SortATPADistFirstPoint;
         StrPCopy(ProcDef, 'function SortATPADistFirstPoint(x,y : integer ; ATPA : TPointArrayArray) : TPointArrayArray;');
       end;
    39:
       begin;
         ProcAddr := @CenterTPAEx;
         StrPCopy(ProcDef, 'Procedure CenterTPAEx(var x,y : integer; tpa : TPointArray);');
       end;
    40:
       begin;
         ProcAddr := @SortTPAToATPADist;
         StrPCopy(ProcDef, 'Function SortTPAToATPADist(Dist : Integer; TPA :TPointArray) : TPointArrayArray;');
       end;
    41:
       begin;
         ProcAddr := @FindTPAinTPA;
         StrPCopy(ProcDef, 'Function FindTPAinTPA(SearchTPA, TotalTPA : TPointArray; var Matches : TPointArray) : Boolean;');
       end;
    42:
       begin;
         ProcAddr := @GayBounds;
         StrPCopy(ProcDef, 'Function GayBounds(Points: TPointArray): TBox; ');
       end;
    43:
       begin;
         ProcAddr := @FindGapsTPA;
         StrPCopy(ProcDef, 'Function FindGapsTPA( TPA : TPointArray; MinPixels : Integer) :TpointArrayArray;');
       end;
    44:
       begin;
         ProcAddr := @EditToBounds;
         StrPCopy(ProcDef, 'Procedure EditToBounds( var TPA : TPointArray);');
       end;
    45:
       begin;
         ProcAddr := @FindMaskTolRay;
         StrPCopy(ProcDef, 'Function FindMaskTolRay(xs,ys : integer; const xe,ye,Tol,ContourTol : integer;Const BackgroundAllColors : Boolean; Const Mask : TMaskRay; Const ClientDC : HDC; var mx,my : integer) : Boolean;');
       end;
    46:
       begin;
         ProcAddr := @CreateMaskFromBMP;
         StrPCopy(ProcDef, 'Function CreateMaskFromBMP( BmpDC : HDC) :  TMaskRay;');
       end;
    47:
       begin;
         ProcAddr := @RadixSort;
         StrPCopy(ProcDef, 'Procedure RadixSort(Integers : TIntegerArray; Digits : Integer; Negative : Boolean);');
       end;
    48:
       begin;
         ProcAddr := @QuickSort;
         StrPCopy(ProcDef, 'procedure QuickSort(var arr: TIntegerArray; s, e: integer);');
       end;
    49:
       begin;
         ProcAddr := @RandomArray;
         StrPCopy(ProcDef, 'Procedure RandomArray(var Ints : TIntegerArray; MinRandom,PlusRandom : Integer; Len : Integer);');
       end;
    50:
       begin;
         ProcAddr := @PNGToBitmap;
         StrPCopy(ProcDef, 'Procedure PNGToBitmap(LoadPath,SavePath : String);');
       end;
    51:
       begin;
         ProcAddr := @ShowDllForm;
         StrPCopy(ProcDef, 'procedure ShowDllForm;');
       end;
    52:
       begin;
         ProcAddr := @ShowDllFormModal;
         StrPCopy(ProcDef, 'function ShowDllFormModal:integer;');
       end;
    53:
       begin;
         ProcAddr := @ShowTestFormModal;
         StrPCopy(ProcDef, 'function ShowTestFormModal(AppHandle:integer):longint;');
       end
    else
     x := -1;
  end;
  Result := x;
end;




function GetTypeCount(): Integer; stdcall; export;
begin
  Result := 1;
end;

//*******************************
//  Types you want to add

function GetTypeInfo(x: Integer; var sType, sTypeDef: string): Integer; stdcall;
begin
  case x of
    0:
      begin
        sType := 'TMaskRay';
        sTypeDef := 'Record xOff, yOff : Integer;Width,Height:Integer;CheckPoint : TPoint;WhiteArray : TPointArray;BlackArray : TPointArray;end;';
      end;
    1:
      begin
        sType := 'TNumbers';
        sTypeDef := 'record n1, n2: Integer; end;';
      end;
  else
    x := -1;
  end;
  Result := x;
end;


procedure SetFunctions(Funcs: array of TSCARPlugFunc); stdcall;
var
  i: Integer;
begin
  for i := 0 to Length(Funcs) - 1 do
    if Funcs[i].Name = 'Writeln' then
      Writeln := Funcs[i].Ptr;
end;
exports SetFunctions;

exports GetFunctionCount;
exports GetFunctionInfo;
exports GetTypeCount;
exports GetTypeInfo;

end.

